(*

CS520 Project
William Blair

The implementation for the generator's random number interface.
*)

staload "generator.sats"
staload "random.sats"

staload "container.sats"
staload "container.dats"

(* Needed Libraries *)
staload "contrib/jansson/SATS/jansson.sats"

staload UN = "prelude/SATS/unsafe.sats"

staload "contrib/gsl/SATS/gsl_rng.sats"
staload "contrib/gsl/SATS/gsl_randist.sats"

staload "libc/SATS/time.sats"

exception DistributionError of ()

assume input = JSONptr
assume label = string

datatype my_distribution = 
  | uniform of (label,double,double, distribution -> double)
  | constant of (label,double, distribution -> double)
  | normal of (label,double,double, distribution -> double)
  | exponential of (label,double, distribution -> double)

assume distribution = my_distribution

local
(* All Probability Distributions *)
var distributions : container(distribution) = new_container()
viewdef distributions_view = container(distribution) @ distributions

(* The core random number generator *)
val _ = gsl_rng_env_setup()
var generator_rng : gsl_prng1 = gsl_rng_alloc_exn(gsl_rng_default)
viewdef generator_rng_view = gsl_prng1 @ generator_rng
in
val dst_ptr = &distributions
val generator_rng_ptr = &generator_rng
val distributions_lock = generator_lock_make{distributions_view}( view@(distributions) | (*none*) )
prval generator_rng_guard = generator_guard_make{generator_rng_view} ( view@( generator_rng) )
end

implement
random_setup() = let
  val t1 = time_get()
  prval (pf) = generator_guard_acquire(generator_rng_guard)
  val () = gsl_rng_set(!generator_rng_ptr,$UN.cast2ulint(t1))
  prval () = generator_guard_release(pf | generator_rng_guard)
  in end

implement
distribution_next_number(id) = let
  val (pf | () ) = generator_lock_acquire(distributions_lock)
  val dist = get_from_container(id,!dst_ptr,cmp_dist)
  val result = distribution_next_random_number(dist)
  val () = generator_lock_release(pf | distributions_lock)
  in result end

implement 
distribution_save(dist) = let
  val (pf | () ) = generator_lock_acquire(distributions_lock)
  val () = save_to_container(dist,!dst_ptr)
  val () = generator_lock_release(pf | distributions_lock)
  in end
  
implement 
distribution_remove(id) = let
  val (pf | () ) = generator_lock_acquire(distributions_lock)
  val () = remove_from_container(id,!dst_ptr)
  val () = generator_lock_release( pf | distributions_lock)
  in end
    
implement
distribution_next_random_number(dist) = case+ dist of
  | uniform(_,_,_,next) => next(dist)
  | constant(_,_,next) => next(dist)
  | normal(_,_,_,next) => next(dist)
  | exponential(_,_,next) => next(dist)

implement
cmp_dist (id,dist) =
  let
    val equal = (case+ dist of
                 | uniform(label,_,_,_) => label
                 | constant(label,_,_) => label
                 | normal(label,_,_,_) => label
                 | exponential(label,_,_) => label
                )
  in equal = id end

implement
distribution_parse{l}{n} (data) =
  let
    val () = assert_errmsg(JSONptr_isnot_null data, "Null Distribution Given.")
    val datav = json_incref(data)
    val (pf | type) = json_object_get(datav,"type")
    val () = assert_errmsg(JSONptr_isnot_null type, "Distribution Formatted Incorrectly.")
    val (pf1 | string) = json_string_value(type)
    val () = assert_errmsg(strptr_isnot_null string, "json_string_value failed")
    val x = strptr_dup(string)
    prval () = JSONptr_minus_addback(pf1, string | type)
    prval () = minus_addback(pf, type | datav)
    val () = json_decref(datav)
  in
    case- string_of_strptr(x) of 
      | "uniform" => distribution_parse_uniform(data)
      | "constant" => distribution_parse_constant(data)
      | "normal" => distribution_parse_normal(data)
      | "exponential" => distribution_parse_exponential(data)
  end
 
implement distribution_parse_normal{l}{n}(data) =
   let
    val () = assert_errmsg(JSONptr_isnot_null data, "Null Distribution Given.")
    val datav = json_incref(data)
    val (pf | mean) = json_object_get(datav,"mean")
    val () = assert_errmsg(JSONptr_isnot_null mean, "No Mean Given.")
    val meanv = json_real_value(mean)
    val (pf1 | std) = json_object_get(datav,"std")
    val () = assert_errmsg(JSONptr_isnot_null std, " No Standard Deviation Given.")
    val stdv = json_real_value(std)
    val (pf2 | name) = json_object_get(datav,"name")
    val () = assert_errmsg(JSONptr_isnot_null name, " No Name Given.")
    val (pf3 | string) = json_string_value(name)
    val () = assert_errmsg(strptr_isnot_null string, "json_string_value failed.")
    val label = strptr_dup(string)
    prval () = minus_addback(pf,  mean | datav)
    prval () = minus_addback(pf1, std | datav)
    prval () = JSONptr_minus_addback(pf3,string | name)
    prval () = minus_addback(pf2,name | datav)
    val () = json_decref(datav)
  in 
    normal(string_of_strptr(label),meanv,stdv,distribution_next_normal)
  end
 
implement distribution_parse_exponential{l}{n}(data) = 
   let
    val () = assert_errmsg(JSONptr_isnot_null data, "Null Distribution Given.")
    val datav = json_incref(data)
    val (pf | lambda) = json_object_get(datav,"lambda")
    val () = assert_errmsg(JSONptr_isnot_null lambda, "No Lambda Given.")
    val lambdav = json_real_value(lambda)
    val (pf2 | name) = json_object_get(datav,"name")
    val () = assert_errmsg(JSONptr_isnot_null name, " No Name Given.")
    val (pf3 | string) = json_string_value(name)
    val () = assert_errmsg(strptr_isnot_null string, "json_string_value failed.")
    val label = strptr_dup(string)
    prval () = minus_addback(pf,  lambda | datav)
    prval () = JSONptr_minus_addback(pf3,string | name)
    prval () = minus_addback(pf2,name | datav)
    val () = json_decref(datav)
  in 
    exponential(string_of_strptr(label),lambdav,distribution_next_exponential)
  end

implement distribution_parse_uniform{l}{n}(data) = 
   let
    val () = assert_errmsg(JSONptr_isnot_null data, "Null Distribution Given.")
    val datav = json_incref(data)
    val (pf | min) = json_object_get(datav,"min")
    val () = assert_errmsg(JSONptr_isnot_null min, "No Min Given.")
    val minv = json_real_value(min)
    val (pf1 | max) = json_object_get(datav,"max")
    val () = assert_errmsg(JSONptr_isnot_null max, "No Max Given.")
    val maxv = json_real_value(max)
    val (pf2 | name) = json_object_get(datav,"name")
    val () = assert_errmsg(JSONptr_isnot_null name, " No Name Given.")
    val (pf3 | string) = json_string_value(name)
    val () = assert_errmsg(strptr_isnot_null string, "json_string_value failed.")
    val label = strptr_dup(string)
    prval () = minus_addback(pf,  min | datav)
    prval () = minus_addback(pf1, max | datav)
    prval () = JSONptr_minus_addback(pf3,string | name)
    prval () = minus_addback(pf2,name | datav)
    val () = json_decref(datav)
  in 
    uniform(string_of_strptr(label),minv,maxv,distribution_next_uniform)
  end

implement distribution_parse_constant{l}{n}(data) = 
   let
    val () = assert_errmsg(JSONptr_isnot_null data, "Null Distribution Given.")
    val datav = json_incref(data)
    val (pf | constant_t) = json_object_get(datav,"value")
    val () = assert_errmsg(JSONptr_isnot_null constant_t, "No Constant Given.")
    val constantv = json_real_value(constant_t)
    val (pf2 | name) = json_object_get(datav,"name")
    val () = assert_errmsg(JSONptr_isnot_null name, " No Name Given.")
    val (pf3 | string) = json_string_value(name)
    val () = assert_errmsg(strptr_isnot_null string, "json_string_value failed.")
    val label = strptr_dup(string)
    prval () = minus_addback(pf,  constant_t | datav)
    prval () = JSONptr_minus_addback(pf3,string | name)
    prval () = minus_addback(pf2,name | datav)
    val () = json_decref(datav)
  in 
    constant(string_of_strptr(label),constantv,distribution_next_constant)
  end

implement 
distribution_next_uniform(dist) = case+ dist of
  | uniform(label,min,max,_) =>
    let
      prval (pf) = generator_guard_acquire(generator_rng_guard)
      val result = gsl_ran_flat(!generator_rng_ptr,min,max)
      prval () = generator_guard_release(pf | generator_rng_guard)
    in result end
  | _ =>> $raise DistributionError ()
  
implement
distribution_next_exponential(dist) = case+ dist of
  | exponential(label,lambda,_) =>
    let
      prval (pf) = generator_guard_acquire(generator_rng_guard)
      val result = gsl_ran_exponential(!generator_rng_ptr,lambda)
      prval () = generator_guard_release(pf | generator_rng_guard)
    in result end
  | _ =>> $raise DistributionError ()
  
implement
distribution_next_constant(dist) = case+ dist of
  | constant(label,const,_) => const
  | _ =>> $raise DistributionError()

implement
distribution_next_normal(dist) = case+ dist of
  | normal(label,mean,std,_) => 
     let
      prval (pf) = generator_guard_acquire(generator_rng_guard)
      val normal = gsl_ran_gaussian(!generator_rng_ptr,std)
      val result = normal + mean
      prval () = generator_guard_release(pf | generator_rng_guard)
    in result end
  | _ =>> $raise DistributionError()